Delphi 2.0 - Programmer's Utilities Power Pack/Delphi 2.0 Programmer's Utilities Power Pack.iso/s_to_z/tpack/okcore.pas

Pascal/Delphi Source File | 1996-09-15 | 12.7 KB | 395 lines

unit OkCore; {Home of TOk, the OK Component.}

{base components to start a process and signal/negotiate go/stop.}

{Sounds simple, but boy, this was my first component and kept me scratching my head
for an embaressingly long time. YOU need this functionality now and here it is.}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls
, Retry
, PasUtils
, UserInfo;

type

{------------------------------------------------------------------------------}
{TOk defines the essential stopability that other components rely on.
It requests permission to change states and performs tries on on/off
it also can disable 'other' windows when running to make is seem modal. <explore this.useful}

  TOk = class;

  TOkState = (stsActive,stsCritical,stsReady,stsCanceled,stsDisabled);  {must improve!}

  TOkAware = class(TDialogShell)
  private
    fEnabled:        Boolean;  {allow changes only if enabled}
    fActive:         Boolean;   {read only, true until done}
    fProcessMessages: Boolean;
  protected
    procedure SetActive(Flag:Boolean);  virtual;
    function GetActive:Boolean;
  public
    constructor Create(AOwner:TComponent); override;
    procedure Execute; override;
  published
    property  Active: Boolean   read GetActive   write SetActive;
    property  Enabled: Boolean  read fEnabled  write fEnabled default true;
    property  ProcessMessages: Boolean read fProcessMessages write fProcessMessages default true;
  end;

{------------------------------------------------------------------------------}

  EOkAlreadyActive = class(Exception);
  EOkDoAlreadyActive = class(EOkAlreadyActive);

{------------------------------------------------------------------------------}

  TOkOnOkStart  = procedure(Sender: TOk;Var CanStart:Boolean) of object;
  TOkOnOkStop   = procedure(Sender: TOk;Var CanStop:Boolean) of object;
  TOkOnOkChange = procedure(Sender: TOk;NewState:TOkState;Var CanChange:Boolean) of object;

  TOk = class(TOkAware)
    {TOk remains completely invisible but let you hookup begin/end procs that
    make it simple for you to hook up changes to captions or do whatever
    you need to keep the user happy while running your Ok action. To use,
    set Active:=True when beginning your loop, then check 'Active' or 'Stop'
    while looping to Process Messages and exit properly. Your Cancel button can
    signal a normal or cancel outcome by setting Active:=False or Canceled:=True.
    Deactivating in either ways can be denied by the OnOkStop procedure.}

    {simple, right?
     you could call this component from a button like this:
      Ok1.Active:=not Ok1.Active;
      if Ok1.Active then
        Button1.Caption:='Running'
      else
        Button1.Caption:='Stopped';
    }
  private
    { Private declarations }
    fCritical:       Boolean; {disable OkBox button, on hold}
    fCanceled:       Boolean; {Ok canceled on last try}
    fFrozen:         Boolean;   {other forms disabled while true}
    fFreeze:         Boolean;   {disable other forms while true}
    fOnOkStart:      TOkOnOkStart;{OnOkStart proc to ok-ok. eg. oks ative=true}
    fOnOkChange:     TOkOnOkChange;{ok-ok. eg. oks ative=true}
    fOnOkStop:       TOkOnOkStop;  {ok-ok. eg. oks ative=true}
  protected
    { Protected declarations }
    procedure   SetActive(Flag:Boolean);             override;
    procedure   SetEnabled(Flag:Boolean);            virtual;
    procedure   SetStop(Flag:Boolean);               virtual;
    procedure   SetCritical(Flag:Boolean);           virtual;
    procedure   SetCanceled(Flag:Boolean);           virtual;
    procedure   SetState(State:TOkState);            virtual;
    procedure   SetFrozen(Flag:Boolean;ButNot:HWND); virtual;
    function    GetStop:Boolean;
    function    GetState:TOkState;
    function    GetStringState:String;
    procedure   DoOkStart(Var CanStart:Boolean);                     virtual;
    procedure   DoOkChange(NewState:TOkState;Var CanChange:Boolean); virtual;
    procedure   DoOkStop(Var CanStop:Boolean);                       virtual;
    function    FreezeFormHandle:HWND;               virtual;
  public
    { Public declarations }
    constructor Create(AOwner:TComponent);           override;
    procedure   Run(Sender:TObject;Var Success: Boolean); virtual;
    procedure   OkOn;                                virtual;
    procedure   OkOff;                               virtual;
    procedure   Reset;                               virtual;
    function    BenchmarkLoopsPerSecond:LongInt;
    function    StringState(State:TOkState):String;
  published
    property Enabled: Boolean            read fEnabled  write SetEnabled default true;
{    property Active: Boolean             read fActive   write SetActive;}
    {note if you disable, only enabled and state will change. you can not
    disable the control in a critical section.}
    property Ok: Boolean                 read fActive   write SetActive; {ALIAS}
    property Stop: Boolean               read GetStop   write SetStop default true;
    property Critical: Boolean           read fCritical write SetCritical;
    property Canceled: Boolean           read fCanceled write SetCanceled;
    property State: TOkState             read GetState  write SetState default stsReady;
    property StateString: String         read GetStringState;
    property FreezeForms: Boolean        read fFreeze   write fFreeze;
    property OnOkStart: TOkOnOkStart     read fOnOkStart write fOnOkStart;
    property OnOkChange: TOkOnOkChange   read fOnOkChange write fOnOkChange;
    property OnOkStop: TOkOnOkStop       read fOnOkStop write fOnOkStop;
  end;


implementation

{------------------------------------------------------------------------------}

constructor TOkAware.Create(AOwner:TComponent);
begin
  inherited create(AOwner);
  fEnabled:=true;
  fProcessMessages:=true;
end;

procedure TOkAware.SetActive(Flag:Boolean);
begin
  if fActive<>Flag then
    fActive:=Flag;
end;

function TOkAware.GetActive:Boolean;
begin
  if fProcessMessages then
    Application.ProcessMessages;
  Result:=fActive;
end;

procedure TOkAware.Execute;
begin
  Active:=True;
end;

{------------------------------------------------------------------------------}
{Let's begin.. here goes the 'root' component, e.g.  the Ok capability.}

constructor TOk.Create(AOwner:TComponent);
begin
  inherited create(AOwner);
  fEnabled:=True;
end;

procedure TOk.Reset;
{Unconditially resets the component and puts it in ready mode. use at own risk.
{this methd allows you to stop a OkTry regardless of the callback method's
opinion. we simply take it out, shut off and put it back. it never knows.}
var
  e:TOkOnOkStop;
begin
  e:=fOnOkStop;
  fOnOkStop:=nil;
  State:=stsReady;
  {note: this is the only time we actually resort to changing the component's
  state. usually we just manipulate the flags directly but here we want to take
  advantage of the override logic in SetState.}
  {you might think we should make the status canceled if we shut down a loop.
  that wouldn't be right either because we really 'excepted' out of the OkTry.}
  fOnOkStop:=e;
end;

procedure TOk.Run(Sender:TObject;Var Success: Boolean);
begin
  SetActive(True);
  SetActive(False);
end;

procedure TOk.OkOn;
begin
  Active:=True;
end;

procedure TOk.OkOff;
begin
  Active:=False;
end;

function TOk.BenchmarkLoopsPersecond:Longint;
begin
  result:=-1;
  {instantiate timer w/proc to signal end (could use another ok)
  then count how often we can turn ok on/off inside that time.}
end;

procedure TOk.SetEnabled(Flag:Boolean);
begin
  if Flag<>fEnabled then begin
    if (not Flag) and fActive and fCritical then {can not stop in a critical section!}
      Exit;
    if fActive and (Flag=false) then
      Active:=False; {turn off. OnOkStop may deny.}
   {implement okchange!}
    fEnabled:=fActive or Flag;
    end;
end;

procedure TOk.SetCanceled(Flag:Boolean);
begin
  if fEnabled and Flag<>fCanceled then begin
    if flag then       {do not activate when resetting flag}
      SetStop(Flag);
    if Flag<>fCanceled then begin
      DoOkChange(stsCanceled,Flag);
      fCanceled:=Flag;
      end;
    end;
end;

procedure TOk.SetStop(Flag:Boolean);
begin
  Active:=not Flag;
end;

function TOk.GetStop:Boolean;
begin
  Result:=not Active;
end;

procedure TOk.SetActive(Flag:Boolean);
var
  Close: Boolean;
begin
  if fEnabled and Flag<>fActive then begin
    if Flag then begin
      if fActive then
        raise EOkAlreadyActive.Create('TOk: Already Active');
      fCanceled:=False;
      DoOkChange(stsActive,Flag);
      if flag then
        DoOkStart(Flag);
      fActive:=false;
      if not flag then
        exit;
      end
    else begin
      if fActive and fCritical then {can not stop in a critical section!}
        Exit;
      Close:= true;
      DoOkChange(stsReady,close);
      if Close then
        DoOkStop(close);
      fActive:=true;
      if not Close then
        exit;
      end;
    if flag<>fActive then begin
      fActive:=Flag;
      SetFrozen(fActive and fFreeze,FreezeFormHandle);
      end;
    end;
end;

procedure TOk.SetCritical(Flag:Boolean);
{OkTry can not be stopped when in a critical section}
{it can start in 'critical' mode where it can not be stopped-
however the component can not be enabled without resetting critical to neutral,
note that 'enabling' is not 'activating'. you can go from ready mode to critical,
just going from disabled to critical is not possible. makes sense?}
begin
  if fEnabled and Flag<>fCritical then
    fCritical:={fActive and} Flag;
end;

procedure TOk.SetState(State:TOkState);
{by setting the state, you get a shortcut way to change the properties
you want to change. REMEMBER!: CRITICAL=TRUE forces the box to stay on,
ENABLE=FALSE forces it to stay off. no matter how often you try, these
properties will block you from changing others. In critical sections the
OnOkStop procedure is never called.}
begin
  case State of
    stsActive:   if fCritical and fActive then
                   Critical:= False {transit back from critical to active}
                 else
                   Active:=   True;
    stsCritical: if fActive then
                   Critical:= True;
    stsReady:    begin
                 if fEnabled=false then
                   fEnabled:=True;
                 if fCritical then
                   fCritical:=False;
                 Canceled:=False;
                 end;
    stsCanceled: Canceled:= True;
    stsDisabled: Enabled:=  False;
    end;
end;

function TOk.GetState:TOkState;
{you definitely must play with this component in the object inspector before
using it. the CRITICAL/ENABLED flags must be understood to be useful. the 'State'
property should make the logic clearer.}
begin
  if not fEnabled then
    Result:=stsDisabled
  else
    if fCanceled then
      Result:=stsCanceled
    else
      if not fActive then
        Result:=stsReady
      else
        if fCritical then
          Result:=stsCritical
        else
          Result:=stsActive;
  if fProcessMessages then
    Application.ProcessMessages;
end;

function TOk.GetStringState:String;
begin
  result:=StringState(State);
end;

function TOk.StringState(State:TOkState):String;
begin
  case State of
  stsActive:      Result:='Active';
  stsCritical:    Result:='Critical';
  stsReady:       Result:='Ready';
  stsCanceled:    Result:='Canceled';
  stsDisabled:    Result:='Disabled';
  end;
end;

procedure TOk.SetFrozen(Flag:Boolean;ButNot:HWND);
var
  i:longint;
begin
  if Flag<>fFrozen then begin
    fFrozen:=Flag;
    for i:=0 to Screen.FormCount-1 do
      if ButNot <> Screen.Forms[i].Handle then
        with Screen.Forms[i] do
          Enabled := not Enabled;
    end;
end;

function TOk.FreezeFormHandle:HWND;
{the purpose of this function is to be replaced by a descendant in case the
usual choice of forms to be unfrozen is not right, and frankly, to allow us
to focus either on the derived OkBox or on the currently active form}
begin
  result:=Screen.ActiveForm.Handle;
end;

{}

procedure TOk.DoOkStart(Var CanStart:Boolean);
begin
  if assigned(fOnOkStart) then
    fOnOkStart(Self,CanStart);
  if CanStart then begin
    fActive:=CanStart;
    fActive:=CanStart;
    end;
end;

procedure TOk.DoOkChange(NewState:TOkState;Var CanChange:Boolean);
begin
  if assigned(fOnOkChange) then fOnOkChange(Self,NewState,CanChange);
end;

procedure TOk.DoOkStop(Var CanStop:Boolean);
begin
  if assigned(fOnOkStop) then
    fOnOkStop(Self,CanStop);
end;

{------------------------------------------------------------------------------}

end.